home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctj8301.arc / TIMEDEMO.PAS < prev   
Pascal/Delphi Source File  |  1986-09-14  |  3KB  |  104 lines
  1. PROGRAM TIMEDEMO(INPUT,OUTPUT);
  2.  
  3. CONST
  4.    COLON = ':';
  5.  
  6. TYPE
  7.    TIME_TYPE = STRING(8);
  8.  
  9. VAR
  10.    REQ_TIME:TIME_TYPE;
  11.    PACKED_VALUE:WORD;
  12.  
  13. PROCEDURE PACK_TIME(TIME_STRING:TIME_TYPE;
  14.                     VAR TIME_WORD:WORD);
  15.  
  16. VAR
  17.    START_POSITION:INTEGER;
  18.    COLON_POSITION:INTEGER;
  19.    TEMP_WORD:WORD;
  20.    TEMP_STRING:LSTRING(2);
  21.    SUCCESS:BOOLEAN;
  22.  
  23. BEGIN   {PACK_TIME}
  24.  
  25.    TIME_WORD := 0;
  26.    START_POSITION := 1;
  27.    COLON_POSITION := POSITN(COLON,TIME_STRING,START_POSITION);
  28.    MOVEL(ADR TIME_STRING[START_POSITION],ADR TEMP_STRING[1],WRD(COLON_POSITION - START_POSITION));
  29.    TEMP_STRING.LEN := LOBYTE(COLON_POSITION - START_POSITION);
  30.    SUCCESS := DECODE(TEMP_STRING,TEMP_WORD);
  31.    TIME_WORD := TIME_WORD + (TEMP_WORD * 2048);
  32.  
  33.    START_POSITION := COLON_POSITION + 1;
  34.    TEMP_WORD := 0;
  35.    COLON_POSITION := POSITN(COLON,TIME_STRING,START_POSITION);
  36.    MOVEL(ADR TIME_STRING[START_POSITION],ADR TEMP_STRING[1],WRD(COLON_POSITION - START_POSITION));
  37.    TEMP_STRING.LEN := LOBYTE(COLON_POSITION - START_POSITION);
  38.    SUCCESS := DECODE(TEMP_STRING,TEMP_WORD);
  39.    TIME_WORD := TIME_WORD + (TEMP_WORD * 32);
  40.  
  41.    START_POSITION := COLON_POSITION + 1;
  42.    TEMP_WORD := 0;
  43.    MOVEL(ADR TIME_STRING[START_POSITION],ADR TEMP_STRING[1],2);
  44.    TEMP_STRING.LEN := 2;
  45.    SUCCESS := DECODE(TEMP_STRING,TEMP_WORD);
  46.    TIME_WORD := TIME_WORD + (TEMP_WORD/WRD(2));
  47.  
  48. END;   {PACK_TIME}
  49.  
  50.  
  51. PROCEDURE UNPACK_TIME(VAR TIME_STRING:TIME_TYPE;
  52.                       TIME_WORD:WORD);
  53.  
  54. VAR
  55.    TEMP_WORD:WORD;
  56.    TEMP_STRING:LSTRING(2);
  57.    SUCCESS:BOOLEAN;
  58.  
  59. BEGIN   {UNPACK_TIME}
  60.  
  61.    TIME_STRING := '        ';
  62.  
  63.    TEMP_WORD := (TIME_WORD AND 16#F800) DIV 2048;
  64.    SUCCESS := ENCODE(TEMP_STRING,TEMP_WORD:2);
  65.    MOVEL(ADR TEMP_STRING[1],ADR TIME_STRING[1],2);
  66.    TIME_STRING[3] := COLON;
  67.  
  68.    TEMP_WORD := (TIME_WORD AND 16#07E0) DIV 32;
  69.    SUCCESS := ENCODE(TEMP_STRING,TEMP_WORD:2);
  70.    IF TEMP_STRING[1] = ' ' THEN TEMP_STRING[1] := '0';
  71.    MOVEL(ADR TEMP_STRING[1],ADR TIME_STRING[4],2);
  72.    TIME_STRING[6] := COLON;
  73.  
  74.    TEMP_WORD := (TIME_WORD AND 16#001F) * 2;
  75.    SUCCESS := ENCODE(TEMP_STRING,TEMP_WORD:2);
  76.    IF TEMP_STRING[1] = ' ' THEN TEMP_STRING[1] := '0';
  77.    MOVEL(ADR TEMP_STRING[1],ADR TIME_STRING[7],2);
  78.  
  79. END;   {UNPACK_TIME}
  80.  
  81.  
  82. BEGIN   {TIMEDEMO}
  83.  
  84.    REPEAT
  85.       PACKED_VALUE := 0;
  86.       WRITE(OUTPUT,'Enter the time [HH:MM:SS]: ');
  87.       READLN(INPUT,REQ_TIME);
  88.       IF REQ_TIME = 'END     ' THEN CYCLE;
  89.       
  90.       PACK_TIME(REQ_TIME,PACKED_VALUE);
  91.       WRITELN(OUTPUT,' ');
  92.       WRITELN(OUTPUT,'   The packed value for ',REQ_TIME,' IS ',PACKED_VALUE);
  93.       WRITELN(OUTPUT,' ');
  94.       REQ_TIME := '        ';
  95.       UNPACK_TIME(REQ_TIME,PACKED_VALUE);
  96.       WRITELN(OUTPUT,'   The unpacked string for ',PACKED_VALUE,' IS ',REQ_TIME);
  97.       WRITELN(OUTPUT,' ');
  98.       WRITELN(OUTPUT,'-------------------------');
  99.    UNTIL REQ_TIME = 'END     ';
  100.  
  101.    WRITELN(OUTPUT,' ');
  102.    WRITELN(OUTPUT,'End of TIMEDEMO program');
  103. END.   {TIMEDEMO}
  104.